perm filename M.OLD[PAG,LCS] blob
sn#598963 filedate 1981-07-12 generic text, type T, neo UTF8
00100 SUBROUTINE STAFF(P0,P1, P3,P4,P5,P6,P7,P8,P9,P10,P11,P12)
00200 COMMON/XRN/RN(1) /PTR/KWDS(1) /SF/KL,RT,KP
00300 KWDS(KP)=KL
00400 KP=KP+1
00500 RN(KL)=P0
00600 RN(KL+1)=P1
00700 RN(KL+2)=RT
00800 RN(KL+3)=P3
00900 RN(KL+4)=P4
01000 RN(KL+5)=P5
01100 IF(P0.LT.4.)GO TO 1
01200 RN(KL+6)=P6
01300 RN(KL+7)=P7
01400 RN(KL+8)=P8
01500 RN(KL+9)=P9
01600 RN(KL+10)=P10
01700 RN(KL+11)=P11
01800 RN(KL+12)=P12
01900 1 KL=KL+3+P0
02000 END
02100
02200 FUNCTION RIGHT(NA,J,JK)
02300 COMMON /PX/KPN(1) /Q/Q(1) /LLL/LLL,LL,I
02400 K=NA+J
02500 N6=NJ
02600 IF(K.GT.0)GO TO 4
02700 RIGHT=Q(4)
02800 RETURN
02900 4 RX=Q(JK+3)
03000 R=Q(JK+2)
03100 JX=1
03200 IF(J.GT.0)JX=I
03300 C FORWARD LOOP
03400 1 R8=CODEN(KPN,K,Q,LA)
03500 IF(R8.EQ.4)GO TO 2
03600 IF(Q(LA+2).NE.R)GO TO 3
03700 IF(R8.EQ.18..OR.R8.EQ.17.)GO TO 2
03800 C JUMP ON KEY SIG OR METER
03900 3 IF(K.EQ.JX)GO TO 5
04000 K=K+J
04100 GO TO 1
04200 5 IF(J.LE.0)RIGHT=RX
04300 RETURN
04400 C SKIP NEXT IF GOING FORWARD IN LOOP (LOOKING TO RIGHT)
04500 C USE ITS OWN POS.-2 IF NOTHING FOUND TO LEFT
04600 C C NOW FOUND ITEM TO LEFT OR RT ON THIS STAFF.
04700 2 RIGHT=Q(LA+3)
04800 END
04900
05000 SUBROUTINE RESTS
05100 COMMON /PX/KPN(1) /Q/Q(1) /LLL/LLL
05200 XLFT=0
05300 SIG=-99
05400 REST=0
05500 K=1
05600 50 JL=KPN(K)
05700 R=Q(JL+1)
05800 IF(XLFT.NE.0)GO TO 5
05900 IF(R.LE.4)XLFT=Q(JL+3)
06000 GO TO 3
06100 5 IF(R.NE.17)GO TO 3
06200 IF(Q(JL+5).EQ.SIG)GO TO 60
06300 SIG=Q(JL+5)
06400 3 IF(R.NE.2)GO TO 231
06500 IF(Q(JL).GE.6)GO TO 7
06600 GO TO 231
06700 7 IF(Q(JL+8).LE.-4)GO TO 231
06800 IF(Q(JL+7).LE.0)GO TO 231
06900 C (IGNORE NON-RHYTH.)
07000 C CATCH BAR REPEAT SIGN
07100 IF(Q(JL+8).EQ.0)GO TO 231
07200 C (WHOLE REST OVER CUE NOTES)
07300 IF(REST.NE.0)GO TO 6
07400 JR=JL+6
07500 C POINTER TO REST NUM.
07600 R=Q(JR+1)
07700 IF(R.LT.5)R=5
07800 Q(JR+1)=R*.6
07900 C REDUCE SIZE OF REST'S TIME SO IT WILL TAKE LESS SPACE.
08000 6 REST=REST+1.
08100 Q(JR+2)=REST
08200 Q(JR-2)=-2.
08300 C (LOWER THE REST'S POS.)
08400 JL=K+2
08500 IF(JL.GE.LLL)RETURN
08600 LB=KPN(JL)
08700 IF(Q(LB+1).NE.2)GO TO 233
08800 C NEXT IS TO COMBINE MEASURES OF REST
08900 IF(Q(LB).LT.6)GO TO 233
09000 C SKIP NON-WHOLE RESTS
09100 N=KPN(JL-1)
09200 IF(Q(N+1).NE.4.)GO TO 233
09300 C IS REST FOLLOWED BY A BAR? OR RHRSL NUM?(COULD BE A PROB. HERE!!!)
09400 C SO IT WON'T BE FOUND NEXT TIME AROUND.
09500 Q(LB+1)=-1.
09600 C CHANGE CODE #
09700 Q(N+1)=-1.
09800 K=JL
09900 GO TO 6
10000 60 Q(JL+1)=-1.
10100 GO TO 231
10200 233 REST=0
10300 231 K=K+1
10400 IF(K.LT.LLL)GO TO 50
10500 END
10600
10700 SUBROUTINE EXCHG(M,N)
10800 DIMENSION M(2),N(2)
10900 J=M(1)
11000 M(1)=M(2)
11100 M(2)=J
11200 J=N(1)
11300 N(1)=N(2)
11400 N(2)=J
11500 END
11600
11700 SUBROUTINE EXCH(J,K)
11800 L=J
11900 J=K
12000 K=L
12100 END
12200
12300 SUBROUTINE INMUS(NAME,EXT,RN,KWDS,JSTFAC)
12400 DIMENSION RN(1),KWDS(1),JSTFAC(1)
12500 CALL GETEXT(NAME,EXT)
12600 CALL EXTIN(JSTFAC,20)
12700 C READ ONLY 20 WDS IN PAGE ONLY****** NOT [=128]
12800 JJ=JSTFAC(19)
12900 C JSTFAC(19) = THE WD CNT.
13000 C ********** CHANGE JSTFAC ARRAY FOR PDP11 ***************
13100 CALL EXTIN(RN,JJ)
13200 C MOVE @15 ;@R ;IF(R(1).NE.INTEGER 1)GO TO I3
13300 C CAIE 1 ;OLD FORMAT ? ***** ASSUMES NEW FORMAT (NO KWDS ARRAY)
13400 C JRST I3 ;NO
13500 C USETI 12,2 ;YES, READ 2ND RECORD AGAIN (12 =CH)
13600 C JSA 16,EXTIN ;CALL EXTIN(RS,128)
13700 C JUMP @12 ;JUMP @KW
13800 C JUMP =17(11) ;JUMP NWDS ;CALL EXTIN(K,J)
13900 C JRST I1 ;GO BACK AND GET R ARRAY
14000 3 N=1
14100 L=1
14200 KWDS(1)=1
14300 4 N=N+RN(N)+3
14400 C HERE'S THE LOOP
14500 C GET WD CNT -2
14600 L=L+1
14700 C UPDATE THE COUNTER OF THE POINTER LIST
14800 KWDS(L)=N
14900 IF(N.LT.JJ)GO TO 4
15000 END
15100
15200 FUNCTION RCURVE(R)
15300 DIMENSION R(1)
15400 C R(1) IS R3 R(4) IS R6, ETC.
15500 X=R(4)-R(1)
15600 RCURVE=R(6)+1.
15700 IF(RCURVE.LT.0)X=X+RCURVE+RCURVE
15800 X=X/25.
15900 C R8=-2=BETWEEN NOTES, =-3=1ST NOTE IS DOTTED.
16000 RCURVE=X+2.+ABS(R(3)-R(2))/10.
16100 IF(R(5).LT.0)RCURVE=-RCURVE
16200 C IF(R7 WAS .LT.0)KEEP IT NEGATIVE.
16300 END
16400
16500 SUBROUTINE SHRNK(K,IT)
16600 COMMON R2,JA,REST,J2,R3,R4,R5,R6,R7,R8,R9
16700 COMMON /PX/KPN(1) /Q/Q(1) /LLL/LLL,LL,I
16800 L10=IT-1
16900 L11=KPN(IT+1)
16950 C END OF Q DATA
17000 C X=Q(L+3)
17100 K2=K
17200 K12=K2
17300 K3=KPN(K2)
17400 K6=K3
17500 C A13=Q(K3+3)
17550 R8=Q(K3+3)
17600 C POS. OF CLEF TO BE MOVED.
17700 K4=KPN(K2+1)
17750 C PTR TO NEXT ITEM
17800 K1=K4
17900 K3=K3-K4
17950 C WDCNT OF DELETE ITEM
18000 K4=K4-KPN(K2+2)
18050 C NEXT +1
18100 K3=K3-K4
18150 C AMOUNT OF CHANGE
18200 C1 K5=KPN(K2+2)
18300 C K5=K5-KPN(K2+1)
18400 C K5=K5+KPN(K2)
18500 C KPN(K2+1)=K5
18550 1 KPN(K2+1)=KPN(K2+2)-KPN(K2+1)+KPN(K2)
18600
18700 IF(K2.EQ.L10)GO TO 4
18800 K2=K2+1
18900 GO TO 1
19000 4 K2=KPN(K2+1)
19050 C LAST PTR
19100 C A7=Q(K6+3)
19150 R4=Q(K6+3)
19200 C POS FOR LATER "MOVE"
19400 2 Q(K6)=Q(K1)
19500 K1=K1+1
19600 IF(K1.EQ.L11)GO TO 5
19700 K6=K6+1
19800 GO TO 2
19900 5 IT=L10
20000 I=L10
20100 C I=LEND (FOR FINAL ENDPOINT)
20200 C R4=A7
20250 C R8=A13
20260 C R8=EXPAND REMAINDER OF LINE TO CLEF POS.
20400 6 LL=0
20500 C LL=0 (NO JUSTIFY)
20600 R5=200.
20700 R2=0
20800 R9=R5
20900 R7=0
21200 CALL PTMOVE(Q,KPN(K12))
21300 END
21400
21500 C SUBROUTINE EXPND(J)
21600 CC TO SHIFT LINE TO RT. WHEN ADDING KSIG.
21700 C COMMON/STF/RSTFAC(8),RSTJ2
21710 C COMMON R2,JA,REST,J2,R3,R4,R5,R6,R7,R8,R9
21720 C COMMON /PX/KPN(1) /Q/Q(1) /LLL/LLL,LL,I
21800 CC?? A5=5.
21900 C R4=7.1*RSTJ2
22000 C K12=J+2
22100 CC GET PTR TO KPN ADD 2 (FOR NOW, ANYWAY)
22200 C R8=0
22400 CC GO MOVE IT
23000 C6 LL=0
23100 CC LL=0 (NO JUSTIFY)
23200 C R5=200.
23300 C R2=0
23400 C R9=R5
23500 C R7=0
23800 C CALL PTMOVE(Q,KPN(K12))
23900 C END